home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Unsorted / AMOS-Datenbank.AMOS / AMOS-Datenbank.amosSourceCode next >
Encoding:
AMOS Source Code  |  1993-01-21  |  37.8 KB  |  1,328 lines
  1. ' ********************************** 
  2. ' *                                * 
  3. ' *       AMOS-Datenbank V1.0      * 
  4. ' *     von Christopher Hodges     * 
  5. ' *                                * 
  6. ' ********************************** 
  7. Set Buffer 300
  8. Dim B(60,4)
  9. Gosub INIT1
  10. Dim DAT$(MXENT,MXROW-1),RTX$(MXROW-1),RD(MXROW-1)
  11. Global TEX$,EMP$,AUTORET,RET,MO,B()
  12. Gosub INIT2
  13. ALERT["Musik anschalten?","Jaaa!","Bitte nicht!",""]
  14. If Param=0 Then Track Loop On : Track Play 3
  15. EDI=0 : USERBOX=0
  16. Repeat 
  17.   ALERT["Wollen Sie eine Bank laden?","Sicher doch!","Lieber eine neue anfangen!",""]
  18.   P=Param
  19.   If P=1 Then F$=" " : Gosub NEUEBANK : P=2
  20.   If P=0 Then Gosub LADEN
  21. Until F$<>""
  22. Gosub ROWUPDAT
  23. Do 
  24.   B=0 : M=Mouse Key : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : AC=Asc(Inkey$)
  25.   Multi Wait 
  26.   If M Then Gosub CHECKBUT
  27.   If B=1 Then Gosub LADEN : Erase 16
  28.   If B=2 Then Gosub SPEICHERN
  29.   If B=3 Then Gosub LOESCHEN
  30.   If B=4 Then Gosub NEUEBANK
  31.   If B=5 Then Gosub VERSCHLUESSELN
  32.   If B=6 Then Gosub DATEILOESCHEN
  33.   If B=7 Then Gosub QUIT
  34.   If(B=8 or AC=30) and ROWOF>0 Then Dec ROWOF : Gosub ROWUPDAT
  35.   If(B=9 or AC=31) and ROWOF<ROWS-12 Then Inc ROWOF : Gosub ROWUPDAT
  36.   If B=10 or AC=28 Then Add ENT,1,1 To ENTRIES : Gosub UPDAENTRY
  37.   If B=11 or AC=29 Then Add ENT,-1,1 To ENTRIES : Gosub UPDAENTRY
  38.   If B=12 Then Gosub EINTRAGEINFUEGEN
  39.   If B=13 Then Gosub EINTRAGLOESCHEN
  40.   If B=14 Then Gosub EINTRAGSUCHEN
  41.   If B=15 Then Gosub ALPHABETSORT
  42.   If B=16 Then Gosub SATZDATEN
  43.   If B=17 Then Gosub EINTRAGDRUCKEN
  44.   If B=18 Then Gosub EINTRAGSICHERN
  45.   If B=19 Then Gosub SERIENBRIEFLADEN
  46.   If B=20 Then Gosub SERIENBRIEFSICHERN
  47.   If B=21 Then Gosub SERIENBRIEFZEIGEN
  48.   If B=22 Then Gosub SERIENBRIEFDRUCKEN
  49.   If B>29
  50.     ROW=B-30+ROWOF
  51.     Repeat 
  52.       TEX$=DAT$(ENT,ROW)
  53.       EINGABE[132,57+(ROW-ROWOF)*12,40,RD(ROW),0]
  54.       If DAT$(ENT,ROW)<>TEX$ : EDI=1 : End If 
  55.       DAT$(ENT,ROW)=TEX$
  56.       Add ROW,RET,0 To ROWS-1
  57.       If ROW-ROWOF>11 : ROWOF=ROW-11 : Gosub ROWUPDAT : End If 
  58.       If ROW-ROWOF<0 : ROWOF=ROW : Gosub ROWUPDAT : End If 
  59.     Until RET=0
  60.   End If 
  61. Loop 
  62. End 
  63. SERIENBRIEFDRUCKEN:
  64.   If BRIEF=0 Then ALERT["Es wurde noch kein Serienbrief geladen!","Hoppla!","",""] : Return 
  65.   ALERT["Wollen Sie nur diesen Eintrag ausdrucken?","Yep!","Nein, mehrere!","Nichts ausdrucken!"]
  66.   P=Param
  67.   If P=2 Then Return 
  68.   SD=ENT : ED=ENT
  69.   If P=1 Then Gosub HOLANFANGUNDENDE
  70.   P=0 : PRT=1
  71.   ALERT["Formfeed (Seitenvorschub) nach einem Brief?","Ja!","Nein!",""]
  72.   If Param Then FEED=0 Else FEED=1
  73.   SETUP["Drucke Serienbrief..."]
  74.   Open Out 1,"PRT:"
  75.   For A=SD To ED
  76.     SETMESS["Drucke Eintrag"+Str$(A)+" bis"+Str$(ED)+"..."]
  77.     Gosub MAKELETTER
  78.     If FEED Then Print #1,Chr$(12); Else Print #1,
  79.   Next 
  80.   Close 1
  81.   SHUTUP
  82. Return 
  83. SERIENBRIEFSICHERN:
  84.   If BRIEF=0 Then ALERT["Es wurde noch kein Serienbrief geladen!","Hoppla!","",""] : Return 
  85.   ALERT["Wollen Sie nur diesen Eintrag einf�gen?","Yep!","Nein, mehrere!","Nichts sichern!"]
  86.   P=Param
  87.   If P=2 Then Return 
  88.   SD=ENT : ED=ENT
  89.   If P=1 Then Gosub HOLANFANGUNDENDE
  90.   F$=Fsel$("","","Eintrag speichern","")
  91.   If F$="" Then ALERT["Abgebrochen!","Schade!","",""] : Return 
  92.   SETUP["Sichere Serienbrief..."]
  93.   For A=SD To ED
  94.     If SD-ED=0 Then C$=F$ Else C$=Str$(A)-" " : C$=F$+C$
  95.     SETMESS["Sichere Brief "+Right$(C$,30)+"..."]
  96.     P=0
  97.     If Exist(C$) Then ALERT["Datei existiert schon! Was nun?","�berschreiben!","�berspringen","Abbruch"] : P=Param
  98.     If P=2 Then ALERT["Abgebrochen!","Schade!","",""] : SHUTUP : Return 
  99.     PRT=2
  100.     If P=0 Then Open Out 1,C$ : Gosub MAKELETTER : Close 1
  101.   Next 
  102.   SHUTUP
  103. Return 
  104. HOLANFANGUNDENDE:
  105.   TEX$=Str$(ENT)-" "
  106.   INBOX["Legen Sie den Anfangseintrag fest:","Ok!","Abbruch!",5,1,1,ENTRIES]
  107.   If Param Then Pop : Return 
  108.   SD=Val(TEX$)
  109.   TEX$=""
  110.   INBOX["Geben Sie den letzten Eintrag ein:","Ok!","Abbruch!",5,1,1,ENTRIES]
  111.   If Param Then Pop : Return 
  112.   ED=Val(TEX$)
  113.   If ED<SD
  114.     ALERT["Ich habe die beiden Wert vertauscht!","Gut!","",""]
  115.     Swap SD,ED
  116.   End If 
  117. Return 
  118. SERIENBRIEFZEIGEN:
  119.   If BRIEF=0 Then ALERT["Es wurde noch kein Serienbrief geladen!","Hoppla!","",""] : Return 
  120.   Screen Open 1,640,200,2,$8000
  121.   Curs Off : Palette 0,$FFF
  122.   For A=200 To 0 Step -8
  123.     Screen Display 1,128,A+50,320,200-A
  124.     Wait Vbl 
  125.   Next 
  126.   A=ENT : PRT=0
  127.   Gosub MAKELETTER
  128.   Locate 0,24 : Centre "Bitte die linke Maustaste dr�cken."
  129.   While Mouse Key : Wend 
  130.   Repeat : Until Mouse Key
  131.   Cline 
  132.   For A=0 To 192 Step 8
  133.     Screen Display 1,128,A+50,320,200-A
  134.     Wait Vbl 
  135.   Next 
  136.   Screen Close 1
  137. Return 
  138. MAKELETTER:
  139.   A$="" : B=0 : FIL=0 : Y=0
  140.   ST=Start(15) : AD=ST
  141.   Repeat 
  142.     P=Peek(AD) : Inc AD
  143.     If PRT=0
  144.       If P=10 or P=13 : Print A$ : A$="" : P=0 : Inc Y : End If 
  145.       If Y>22
  146.         Locate 0,24 : Centre "Bitte die linke Maustaste dr�cken, um fortzufahren."
  147.         While Mouse Key : Wend 
  148.         Repeat : Until Mouse Key
  149.         Cls : Y=0
  150.       End If 
  151.     End If 
  152.     If PRT
  153.       If P=10 or P=13 : Print #1,A$ : A$="" : P=0 : End If 
  154.     End If 
  155.     If P=94 Then B=1-B : P=0 : If B=0 Then Gosub INSERT : IN=0 : FIL=0
  156.     If B=1 and P>64 and P<91 Then Gosub INSERT : IN=0 : FIL=0
  157.     If B=1 and P=70 Then FIL=1
  158.     If B=1 and P>47 and P<59 Then IN=IN*10+(P-48)
  159.     If P and B=0 Then A$=A$+Chr$(P)
  160.   Until AD>ST+BRIEF-1
  161. Return 
  162. INSERT:
  163.   If FIL=0 or IN=0 Then Return 
  164.   If IN>ROWS Then Boom : Return 
  165.   A$=A$+DAT$(A,IN-1)
  166. Return 
  167. SERIENBRIEFLADEN:
  168.   F$=Fsel$("","","Serienbrief laden","")
  169.   If F$="" Then ALERT["Abgebrochen!","Schade!","",""] : Return 
  170.   If Exist(F$)=0 Then ALERT["Hey, Du, die Datei existiert ja gar nicht!","Hoppla!","",""] : F$="" : Return 
  171.   SETUP["Lade Serienbrief..."]
  172.   Open In 1,F$ : L=Lof(1) : Close 1
  173.   Erase 15 : Reserve As Work 15,L
  174.   Bload F$,Start(15)
  175.   SHUTUP
  176.   BRIEF=L
  177. Return 
  178. ALPHABETSORT:
  179.   ALERT["Sind Sie sich sicher, da� Sie sortieren wollen?","Ja, sortieren!","Nein!",""]
  180.   If Param Then Return 
  181.   Limit Mouse X Hard(0),Y Hard(38) To X Hard(479),Y Hard(199)
  182.   TX["NACH WELCHER ZEILE SOLL ICH SORTIEREN?",2,40]
  183.   Repeat 
  184.     B=0 : M=Mouse Key : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
  185.     Multi Wait 
  186.     If M Then Gosub CHECKBUT
  187.   Until B>29
  188.   ROW=B-30+ROWOF
  189.   Limit Mouse 128,50 To 487,249
  190.   Gosub ROWUPDAT
  191.   SETUP["Sortiere..."]
  192.   For AA=1 To ENTRIES
  193.     SETMESS["Durchgang"+Str$(AA)+"..."]
  194.     For A=1 To ENTRIES
  195.       If Upper$(DAT$(A,ROW))>Upper$(DAT$(AA,ROW)) and(DAT$(AA,ROW)<>"")
  196.         For B=0 To ROWS-1
  197.           Swap DAT$(A,B),DAT$(AA,B)
  198.         Next 
  199.       End If 
  200.     Next 
  201.   Next 
  202.   SHUTUP
  203.   B=0 : Gosub ROWUPDAT
  204. Return 
  205. EINTRAGDRUCKEN:
  206.   D$="drucken" : PRT=1
  207.   D2$="drucke"
  208.   Gosub EINTRAGBERECHNEN
  209. Return 
  210. EINTRAGSICHERN:
  211.   D$="sichern" : PRT=0
  212.   D2$="sichere"
  213.   Gosub EINTRAGBERECHNEN
  214. Return 
  215. EINTRAGBERECHNEN:
  216.   ALERT["Wollen Sie nur diesen Eintrag "+D$+"?","Yep!","Nein, mehrere!","Nichts "+D$+"!"]
  217.   P=Param
  218.   If P=2 Then Return 
  219.   SD=ENT : ED=ENT
  220.   If P=1 Then Gosub HOLANFANGUNDENDE
  221.   ALERT["Wollen Sie die Satzdaten mit"+D$+"?","Sicherlich","Nope!",""]
  222.   If Param=0 Then SAT=1 Else SAT=0
  223.   C=0
  224.   For B=0 To ROWS-1
  225.     C=Max(Len(RTX$(B)),C)
  226.   Next 
  227.   D=0
  228.   For A=1 To ENTRIES
  229.     For B=0 To ROWS-1
  230.       D=Max(Len(DAT$(A,B)),D)
  231.     Next 
  232.   Next 
  233.   SETUP[Upper$(Left$(D2$,1))+Mid$(D2$,2)+" Eintrag..."]
  234.   If SD-ED=0
  235.     If PRT=0
  236.       Gosub GEFILE
  237.       Open Out 1,F$
  238.     Else 
  239.       Open Out 1,"PRT:"
  240.     End If 
  241.     A=SD : Gosub SIMPLEPRINT
  242.     Close 1
  243.   Else 
  244.     Gosub MULTIPRINT
  245.   End If 
  246.   SHUTUP
  247.   B=0
  248. Return 
  249. MULTIPRINT:
  250.   ALERT["Wollen Sie die Eintr�ge auch nebeneinander "+D$+"?","Wenn's geht?","Rein untereinander!",""]
  251.   If Param=0
  252.     Gosub PARALLELDRUCK
  253.   Else 
  254.     If PRT=0
  255.       Gosub GEFILE
  256.       Open Out 1,F$
  257.     Else 
  258.       Open Out 1,"PRT:"
  259.     End If 
  260.     For A=SD To ED
  261.       Gosub SIMPLEPRINT
  262.     Next 
  263.     Close 1
  264.   End If 
  265. Return 
  266. GEFILE:
  267.   F$=Fsel$("","","Eintrag speichern","")
  268.   If F$="" Then ALERT["Abgebrochen!","Schade!","",""] : Pop : Return 
  269.   P=0
  270.   If Exist(F$) Then ALERT["Datei existiert schon! Was nun?","�berschreiben!","Nichts speichern",""] : P=Param
  271.   If P=1 Then ALERT["Abgebrochen!","Schade!","",""] : Pop : Return 
  272. Return 
  273. PARALLELDRUCK:
  274.   If PRT
  275.     TEX$=Str$(PRLEN)-" "
  276.     INBOX["Wie lang ist eine Zeile auf dem Drucker?","Ok!","",5,1,C*SAT+D+2,200]
  277.     PRLEN=Val(TEX$)
  278.     AZ=(PRLEN-C*SAT)/(D+2)
  279.   Else 
  280.     AZ=(79-C*SAT)/(D+2)
  281.   End If 
  282.   If AZ=1
  283.     ALERT["Leider pa�t nur ein Eintrag in eine Zeile!","Weiter!","Abbruch!",""]
  284.     If Param : Return : End If 
  285.     If PRT=0
  286.       Gosub GEFILE
  287.       Open Out 1,F$
  288.     Else 
  289.       Open Out 1,"PRT:"
  290.     End If 
  291.     For A=SD To ED
  292.       Gosub SIMPLEPRINT
  293.     Next 
  294.     Close 1
  295.     Return 
  296.   End If 
  297.   ALERT["Nebeneinander passen"+Str$(AZ)+" Eintr�ge hin!","Gut so!","Vergi�' es!",""]
  298.   If Param Then Return 
  299.   If PRT=0
  300.     Gosub GEFILE
  301.     Open Out 1,F$
  302.   Else 
  303.     Open Out 1,"PRT:"
  304.   End If 
  305.   For A1=SD To ED Step AZ
  306.     SETMESS[Upper$(Left$(D2$,1))+Mid$(D2$,2)+" Eintrag"+Str$(A1)+" bis"+Str$(Min(A1+AZ-1,ED))]
  307.     For B=0 To ROWS-1
  308.       If SAT Then A$=RTX$(B)+Space$(C-Len(RTX$(B))) Else A$=""
  309.       For A=A1 To A1+AZ-1
  310.         If A>ED Then Exit 
  311.         A$=A$+DAT$(A,B)+Space$(D-Len(DAT$(A,B)))+"  "
  312.       Next 
  313.       Print #1,A$
  314.     Next 
  315.     Print #1,
  316.   Next 
  317.   Close 1
  318. Return 
  319. SIMPLEPRINT:
  320.   SETMESS[Upper$(Left$(D2$,1))+Mid$(D2$,2)+" Eintrag"+Str$(A)]
  321.   For B=0 To ROWS-1
  322.     If SAT Then A$=RTX$(B)+Space$(C-Len(RTX$(B))) Else A$=""
  323.     A$=A$+DAT$(A,B)
  324.     Print #1,A$
  325.   Next 
  326.   Print #1,
  327. Return 
  328. VERSCHLUESSELN:
  329.   ALERT["Wollen Sie das Passwort ein- oder ausschalten?","Einschalten","Ausschalten","Abbruch"]
  330.   P=Param
  331.   If P=2 Then Return 
  332.   If P=1 Then PASS=0 : ALERT["Passwort ausgeschaltet!","Yeah!","",""] : Return 
  333.   PASS=0
  334.   ALERT["Wollen Sie ein Passwort oder eine Passnummer?","Ein Passwort bitte","Zahlen sind mir lieber!",""]
  335.   P=Param
  336.   If P=0 Then Gosub WORDPASS Else Gosub NUMPASS
  337. Return 
  338. WORDPASS:
  339.   PASSTYP=0
  340.   Repeat 
  341.     TEX$=""
  342.     INBOX["Gut. Geben Sie nun das Passwort ein:","Fertig!","Abbruch!",60,2,0,0]
  343.     If(TEX$="") or(Param=1) Then ALERT["Passworteingabe abgebrochen!","Huch!","",""] : Return 
  344.     PASS$=TEX$ : TEX$=""
  345.     INBOX["Zur Sicherheit geben Sie das Passwort nochmal ein:","Ok!","Abbruch!",60,2,0,0]
  346.     If(TEX$="") or(Param=1) Then ALERT["Passworteingabe abgebrochen!","Huch!","",""] : Return 
  347.     If PASS$<>TEX$ Then ALERT["Das Passwort war falsch!","Oh nein!","",""] : Return 
  348.     PASS=0
  349.     For A=1 To Len(PASS$)
  350.       Add PASS,Asc(Mid$(PASS$,A,1))*A
  351.     Next 
  352.     PASS=PASS mod $10000
  353.     If PASS=0 Then ALERT["Bitte nehmen Sie ein anderes Passwort!","H��?","",""]
  354.   Until PASS
  355.   ALERT["Beim n�chsten Speichern wird kodiert!","Sehr gut!","",""]
  356. Return 
  357. NUMPASS:
  358.   PASSTYP=1
  359.   TEX$=Str$(Rnd($FFFF)+1)-" "
  360.   INBOX["Gut. Geben Sie nun den Code ein:","Fertig!","Abbruch!",5,1,1,$FFFF]
  361.   If(TEX$="") or(Param=1) Then ALERT["Passworteingabe abgebrochen!","Huch!","",""] : Return 
  362.   PASS$=TEX$ : TEX$=""
  363.   INBOX["Zur Sicherheit geben Sie den Code nochmal ein:","Ok!","Abbruch!",5,3,1,$FFFF]
  364.   If(TEX$="") or(Param=1) Then ALERT["Passworteingabe abgebrochen!","Huch!","",""] : Return 
  365.   If PASS$<>TEX$ Then ALERT["Der Code war falsch!","Oh nein!","",""] : Return 
  366.   PASS=Val(TEX$)
  367.   ALERT["Beim n�chsten Speichern wird kodiert!","Sehr gut!","",""]
  368. Return 
  369. SATZDATEN:
  370.   ALERT["Sind Sie sich sicher? (evtl Datenverlust?)","Ja!","Nee!","Optimieren!"]
  371.   P=Param
  372.   If P=1 Then Return 
  373.   If P=2 Then Gosub OPTIMIZE : Return 
  374.   Gosub SATZDATENAENDERN
  375.   DUMMY=0 : DUMMY4=0
  376.   For B=0 To ROWS-1
  377.     D=RD(B)
  378.     For A=1 To ENTRIES
  379.       A$=DAT$(A,B) : B$=Left$(A$,D)
  380.       While Right$(A$,1)=" " : A$=Left$(A$,Len(A$)-1) : Wend 
  381.       If Len(B$)<Len(A$) Then Inc DUMMY : Add DUMMY4,Len(A$)-Len(B$)
  382.     Next 
  383.   Next 
  384.   If DUMMY
  385.     ALERT["Sie verlieren in"+Str$(DUMMY)+" Zeilen insgesamt"+Str$(DUMMY4)+" Zeichen!","Optimieren","Macht nix!",""]
  386.     If Param=0
  387.       Gosub OPTIMIZE
  388.     Else 
  389.       For B=0 To ROWS-1
  390.         For A=1 To ENTRIES
  391.           DAT$(A,B)=Left$(DAT$(A,B),RD(B))
  392.         Next 
  393.       Next 
  394.     End If 
  395.   End If 
  396.   EDI=1
  397. Return 
  398. REDRAWROW:
  399.   Ink 2 : Bar 2,52 To 477,197
  400.   For A=0 To Min(ROWS-1,11)
  401.     B[130,55+A*12,454,65+A*12]
  402.   Next 
  403. Return 
  404. OPTIMIZE:
  405.   SETUP["Optimiere..."]
  406.   For B=0 To ROWS-1
  407.     D=2 : DUMMY=0
  408.     For A=1 To ENTRIES
  409.       A$=DAT$(A,B)
  410.       While Right$(A$,1)=" " : A$=Left$(A$,Len(A$)-1) : Wend 
  411.       DAT$(A,B)=A$
  412.       D=Max(Len(A$),D)
  413.     Next 
  414.     If D and 1 Then Inc D
  415.     Add DUMMY,RD(B)-D
  416.     RD(B)=D
  417.   Next 
  418.   SHUTUP
  419.   If DUMMY=0 Then ALERT["Hat leider nichts gebracht!","Ach, wie schade!","",""] : Return 
  420.   EDI=1
  421.   ALERT["Damit sparen Sie"+Str$(DUMMY*ENTRIES)+" Zeichen!","Yeah!","",""]
  422. Return 
  423. DATEILOESCHEN:
  424.   F$=Fsel$("","","Datei l�schen","")
  425.   If F$="" Then ALERT["Abgebrochen","Gut so!","",""] : Return 
  426.   ALERT["Wollen Sie "+Right$(F$,30)+" wirklich l�schen?","Nat�rlich","Um Himmelswillen nein!",""]
  427.   If Param=1 Then Return 
  428.   If Exist(F$)=0 Then ALERT["Hey, Du, die Datei existiert ja gar nicht!","Hoppla!","",""] : Return 
  429.   SETUP["L�sche Datei..."]
  430.   Kill F$
  431.   SHUTUP
  432. Return 
  433. QUIT:
  434.   ALERT["Sind Sie wirklich sicher?","Tja, leider","Huch! War nicht so gemeint",""]
  435.   If Param=1 Then Return 
  436.   P=0
  437.   If EDI Then ALERT["Bank noch nicht abgespeichert!","Weg damit!","Huch! Speichern","'Tschuldigung!"] : P=Param
  438.   If P=2 Then Return 
  439.   If P=1
  440.     Gosub SPEICHERN
  441.     If F$=""
  442.       ALERT["Abbrechen, oder was?","Doch beenden!","Nee, vergi� es!",""]
  443.       If Param=1 : Return : End If 
  444.     End If 
  445.   End If 
  446.   Fade 2 : Wait 32
  447.   Track Stop 
  448.   Screen Close 0
  449. End 
  450. EINTRAGSUCHEN:
  451.   DUMMY=ENT
  452.   P=1
  453.   If WEIT Then ALERT["Weitersuchen?","Nat�rlich!","Neue Parameter!","Abbruch!"] : P=Param
  454.   If P=2 Then Return 
  455.   ENT=0
  456.   If P=0 Then Add DUMMY,1,1 To ENTRIES : Goto SKIP
  457.   WEIT=1
  458.   ALERT["Gro�buchstaben=Kleinbuchstaben?","JA!","nein!",""]
  459.   P=Param
  460.   If P=2 Then Return 
  461.   If P Then UPC=0 Else UPC=1
  462.   Limit Mouse X Hard(0),Y Hard(38) To X Hard(479),Y Hard(199)
  463.   Gosub ROWUPDAT
  464.   TX["BITTE ALLE SUCHSTRINGS EINGEBEN",2,40]
  465.   SETB[45,320,40,477,50,"FERTIG!"]
  466.   USERBOX=1
  467.   Repeat 
  468.     B=0 : M=Mouse Key : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
  469.     Multi Wait 
  470.     If M Then Gosub CHECKBUT
  471.     If B>29 and B<43
  472.       ROW=B-30+ROWOF
  473.       Repeat 
  474.         TEX$=DAT$(0,ROW)
  475.         EINGABE[132,57+(ROW-ROWOF)*12,40,RD(ROW),0]
  476.         DAT$(0,ROW)=TEX$
  477.         Add ROW,RET,0 To ROWS-1
  478.         If ROW-ROWOF>11 : ROWOF=ROW-11 : Gosub ROWUPDAT : End If 
  479.         If ROW-ROWOF<0 : ROWOF=ROW : Gosub ROWUPDAT : End If 
  480.       Until RET=0
  481.     End If 
  482.   Until B=45
  483.   USERBOX=0
  484.   Limit Mouse 128,50 To 487,249
  485.   Ink 2 : Bar 2,40 To 477,50
  486. SKIP:
  487.   SETUP["Suche Eintrag..."]
  488.   For A=DUMMY To ENTRIES
  489.     If(A mod 10)=0 Then SETMESS["Eintrag"+Str$(A)+"..."]
  490.     C=0
  491.     For B=0 To ROWS-1
  492.       If UPC Then A$=Upper$(DAT$(0,B)) : B$=Upper$(DAT$(A,B)) Else A$=DAT$(0,B) : B$=DAT$(A,B)
  493.       If A$=""
  494.         Inc C
  495.       Else 
  496.         If B$<>""
  497.           If Instr(B$,A$)
  498.             Inc C
  499.           End If 
  500.         End If 
  501.       End If 
  502.     Next 
  503.     Exit If C=ROWS
  504.   Next 
  505.   SHUTUP
  506.   If A=ENTRIES+1 Then ALERT["Nichts gefunden!","Mist!","",""] Else DUMMY=A
  507.   ENT=DUMMY : ROW=0 : ROWOF=0 : B=0
  508.   Gosub ROWUPDAT
  509. Return 
  510. EINTRAGEINFUEGEN:
  511.   If ENTRIES=MXENT Then ALERT["Kein Platz mehr!","Mist!","",""] : Return 
  512.   ALERT["Wo wollen Sie den Eintrag einf�gen? Zwischen","vorherigen und diesem","diesem und n�chsten",""]
  513.   P=Param
  514.   If P=0
  515.     For A=ENTRIES To ENT Step -1
  516.       For B=0 To ROWS-1
  517.         DAT$(A+1,B)=DAT$(A,B)
  518.       Next 
  519.     Next 
  520.     For B=0 To ROWS-1
  521.       DAT$(ENT,B)=""
  522.     Next 
  523.   Else 
  524.     For A=ENTRIES To ENT+1 Step -1
  525.       For B=0 To ROWS-1
  526.         DAT$(A+1,B)=DAT$(A,B)
  527.       Next 
  528.     Next 
  529.     Inc ENT
  530.     For B=0 To ROWS-1
  531.       DAT$(ENT,B)=""
  532.     Next 
  533.   End If 
  534.   B=0
  535.   Inc ENTRIES
  536.   Gosub UPDAENTRY
  537. Return 
  538. EINTRAGLOESCHEN:
  539.   ALERT["Wollen Sie den ganzen Eintrag oder den Inhalt l�schen?","Ganzen Eintrag","Nur den Inhalt","Keine Ahnung!"]
  540.   P=Param
  541.   If P=2 Then Return 
  542.   If P=1
  543.     For A=0 To ROWS-1
  544.       DAT$(ENT,A)=""
  545.     Next 
  546.     Gosub UPDAENTRY
  547.     Return 
  548.   End If 
  549.   If ENTRIES=1 Then ALERT["Tut mir leid, ein Eintrag mu� dableiben!","Ach so!","",""] : Return 
  550.   If ENT=ENTRIES Then Dec ENT : Dec ENTRIES : Gosub UPDAENTRY : Return 
  551.   For A=ENT+1 To ENTRIES
  552.     For B=0 To ROWS-1
  553.       DAT$(A-1,B)=DAT$(A,B)
  554.     Next 
  555.   Next 
  556.   B=0 : Dec ENTRIES
  557.   ENT=Max(ENT-1,1)
  558.   Gosub UPDAENTRY
  559. Return 
  560. NEUEBANK:
  561.   P=0
  562.   If EDI Then ALERT["Bank noch nicht abgespeichert!","Weg damit!","Huch! Speichern","'Tschuldigung!"] : P=Param
  563.   If P=2 Then F$="" : Return 
  564.   If P=1
  565.     Gosub SPEICHERN
  566.     If F$=""
  567.       ALERT["Abbrechen, oder was?","Doch neue Bank","Nee, vergi� es!",""]
  568.       If Param=1 : Return : End If 
  569.     End If 
  570.   End If 
  571.   TEX$=Str$(ENTRIES)-" "
  572.   INBOX["Wieviele Eintr�ge?","OK!","Abbruch!",5,1,1,MXENT]
  573.   If Param=1 Then F$="" : Return 
  574.   ENTRIES=Val(TEX$)
  575.   ENT=1 : ROW=0 : ROWOF=0
  576.   SETUP["L�sche Datenbank..."]
  577.   For A=0 To MXROW-1
  578.     RTX$(A)=""
  579.   Next 
  580.   For B=0 To MXROW-1
  581.     RD(B)=40
  582.   Next 
  583.   For A=1 To ENTRIES
  584.     If(A mod 10)=0 Then SETMESS["Eintrag"+Str$(A)]
  585.     For B=0 To MXROW-1
  586.       DAT$(A,B)=""
  587.     Next 
  588.   Next 
  589.   SHUTUP
  590.   Gosub SATZDATENAENDERN
  591.   EDI=0
  592. Return 
  593. SATZDATENAENDERN:
  594.   Limit Mouse X Hard(0),Y Hard(38) To X Hard(479),Y Hard(199)
  595.   DUMMY2=ENT
  596.   B[0,38,479,199]
  597.   TEX$=Str$(ROWS)-" "
  598.   DUMMY=ROWS
  599.   INBOX["Wieviele Zeilen?","OK!","Abbruch!",5,1,2,MXROW]
  600.   If Param=0 Then ROWS=Val(TEX$)
  601.   If DUMMY<ROWS
  602.     For B=DUMMY To ROWS-1
  603.       RD(B)=40
  604.     Next 
  605.     For A=1 To ENTRIES
  606.       For B=DUMMY To ROWS-1
  607.         DAT$(A,B)=""
  608.       Next 
  609.     Next 
  610.   End If 
  611.   USERBOX=4+Min(ROWS,12)
  612.   Gosub REDRAW
  613.   For B=0 To ROWS-1
  614.     DAT$(0,B)=Str$(RD(B))-" "
  615.   Next 
  616.   ENT=0 : Gosub ROWUPDAT
  617.   SETB[45,2,40,125,50,"EINF�GEN"]
  618.   SETB[46,127,40,250,50,"L�SCHEN"]
  619.   SETB[47,252,40,375,50,"AUSTAUSCHEN"]
  620.   SETB[48,377,40,477,50,"FERTIG!"]
  621.   Repeat 
  622.     B=0 : M=Mouse Key : AC=Asc(Inkey$) : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
  623.     Multi Wait 
  624.     If AC=30 and ROWOF>0 Then Dec ROWOF : Gosub ROWUPDAT
  625.     If AC=31 and ROWOF<ROWS-12 Then Inc ROWOF : Gosub ROWUPDAT
  626.     If M Then Gosub CHECKBUT
  627.     If B=45 Then Gosub ZEILEEINFUEGEN
  628.     If B=46 Then Gosub ZEILELOESCHEN
  629.     If B=47 Then Gosub ZEILESWAP
  630.     If B>48
  631.       ROW=B-49+ROWOF
  632.       Repeat 
  633.         TEX$=RTX$(ROW)
  634.         EINGABE[2,57+(ROW-ROWOF)*12,16,16,0]
  635.         RTX$(ROW)=TEX$
  636.         Add ROW,RET,0 To ROWS-1
  637.         If ROW-ROWOF>11 : ROWOF=ROW-11 : Gosub ROWUPDAT : End If 
  638.         If ROW-ROWOF<0 : ROWOF=ROW : Gosub ROWUPDAT : End If 
  639.       Until RET=0
  640.     End If 
  641.     If B>29 and B<43
  642.       ROW=B-30+ROWOF
  643.       Repeat 
  644.         TEX$=Str$(RD(ROW))-" "
  645.         EINGABE[132,57+(ROW-ROWOF)*12,10,3,1]
  646.         RD(ROW)=Min(Max(Val(TEX$),2),250)
  647.         If RD(ROW) and 1 : Inc RD(ROW) : End If 
  648.         DAT$(ENT,ROW)=Str$(RD(ROW))-" "
  649.         Add ROW,RET,0 To ROWS-1
  650.         If ROW-ROWOF>11 : ROWOF=ROW-11 : Gosub ROWUPDAT : End If 
  651.         If ROW-ROWOF<0 : ROWOF=ROW : Gosub ROWUPDAT : End If 
  652.       Until RET=0
  653.     End If 
  654.   Until B=48
  655.   For B=0 To ROWS-1
  656.     DAT$(0,B)=""
  657.   Next 
  658.   USERBOX=0
  659.   Limit Mouse 128,50 To 487,249
  660.   Ink 2 : Bar 2,40 To 477,50
  661.   Bar 1,40 To 129,198
  662.   EDI=1 : ENT=DUMMY2 : ROW=0 : ROWOF=0 : B=0
  663.   Gosub ROWUPDAT
  664. Return 
  665. ZEILEEINFUEGEN:
  666.   If ROWS=MXROW Then ALERT["Kein Platz mehr!","Mist!","",""] : Return 
  667.   Ink 2 : Bar 2,40 To 477,50
  668.   TX["ZWISCHEN WELCHEN ZEILEN SOLL ICH EINF�GEN?",2,40]
  669.   USERBOX=0
  670.   Repeat 
  671.     B=0 : M=Mouse Key : AC=Asc(Inkey$) : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
  672.     Multi Wait 
  673.     If AC=30 and ROWOF>0 Then Dec ROWOF : Gosub ROWUPDAT
  674.     If AC=31 and ROWOF<ROWS-12 Then Inc ROWOF : Gosub ROWUPDAT
  675.     If M Then Gosub CHECKBUT
  676.   Until B>29
  677.   ROW=B-30+ROWOF
  678.   ALERT["Wo wollen Sie die Zeile einf�gen? Zwischen","vorheriger und dieser","dieser und n�chster",""]
  679.   P=Param
  680.   SETUP["F�ge Zeile ein..."]
  681.   If P=0
  682.     For A=0 To ENTRIES
  683.       If(A mod 10)=0 : SETMESS["Eintrag"+Str$(A)] : End If 
  684.       For B=ROWS To ROW Step -1
  685.         DAT$(A,B+1)=DAT$(A,B)
  686.       Next 
  687.       DAT$(A,ROW)=""
  688.     Next 
  689.     For B=ROWS To ROW Step -1
  690.       RTX$(B+1)=RTX$(B)
  691.       RD(B+1)=RD(B)
  692.     Next 
  693.   Else 
  694.     For A=0 To ENTRIES
  695.       If(A mod 10)=0 : SETMESS["Eintrag"+Str$(A)] : End If 
  696.       For B=ROWS To ROW+1 Step -1
  697.         DAT$(A,B+1)=DAT$(A,B)
  698.       Next 
  699.       DAT$(A,ROW)=""
  700.     Next 
  701.     For B=ROWS To ROW+1 Step -1
  702.       RTX$(B+1)=RTX$(B)
  703.       RD(B+1)=RD(B)
  704.     Next 
  705.     Inc ROW
  706.   End If 
  707.   SHUTUP
  708.   RTX$(ROW)="" : RD(ROW)=40
  709.   DAT$(0,ROW)=Str$(RD(ROW))-" "
  710.   B=0
  711.   Inc ROWS
  712.   Ink 2 : Bar 2,40 To 477,50
  713.   USERBOX=4+Min(ROWS,12)
  714.   Gosub REDRAW
  715.   Gosub ROWUPDAT
  716.   SETB[45,2,40,125,50,"EINF�GEN"]
  717.   SETB[46,127,40,250,50,"L�SCHEN"]
  718.   SETB[47,252,40,375,50,"AUSTAUSCHEN"]
  719.   SETB[48,377,40,477,50,"FERTIG!"]
  720. Return 
  721. ZEILELOESCHEN:
  722.   If ROWS<3 Then ALERT["Tut mir leid, es m�ssen min. 2 Zeilen dableiben!","Ach so!","",""] : Return 
  723.   ALERT["Sind Sie sicher?","Yep!","Oh, Entschuldigung!",""]
  724.   If Param=1 Then Return 
  725.   Ink 2 : Bar 2,40 To 477,50
  726.   TX["WELCHE ZEILE SOLL ICH L�SCHEN?",2,40]
  727.   USERBOX=0
  728.   Repeat 
  729.     B=0 : M=Mouse Key : AC=Asc(Inkey$) : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
  730.     Multi Wait 
  731.     If AC=30 and ROWOF>0 Then Dec ROWOF : Gosub ROWUPDAT
  732.     If AC=31 and ROWOF<ROWS-12 Then Inc ROWOF : Gosub ROWUPDAT
  733.     If M Then Gosub CHECKBUT
  734.   Until B>29
  735.   ROW=B-30+ROWOF
  736.   For B=ROW To ROWS-2
  737.     RTX$(B)=RTX$(B+1)
  738.     RD(B)=RD(B+1)
  739.   Next 
  740.   If ROW<>ROWS
  741.     SETUP["L�sche Zeile..."]
  742.     For A=0 To ENTRIES
  743.       If(A mod 10)=0 : SETMESS["Eintrag"+Str$(A)] : End If 
  744.       For B=ROW To ROWS-2
  745.         DAT$(A,B)=DAT$(A,B+1)
  746.       Next 
  747.     Next 
  748.     SHUTUP
  749.   End If 
  750.   B=0 : Dec ROWS
  751.   ROW=Max(ROW-1,0)
  752.   ROWOF=Max(ROWOF-1,0)
  753.   Ink 2 : Bar 2,40 To 477,50
  754.   USERBOX=4+Min(ROWS,12)
  755.   Gosub REDRAW : Gosub ROWUPDAT
  756.   SETB[45,2,40,125,50,"EINF�GEN"]
  757.   SETB[46,127,40,250,50,"L�SCHEN"]
  758.   SETB[47,252,40,375,50,"AUSTAUSCHEN"]
  759.   SETB[48,377,40,477,50,"FERTIG!"]
  760. Return 
  761. ZEILESWAP:
  762.   ALERT["Sind Sie sicher?","Yep!","Oh, Entschuldigung!",""]
  763.   If Param=1 Then Return 
  764.   Ink 2 : Bar 2,40 To 477,50
  765.   TX["WELCHE ZEILE SOLL ICH VERTAUSCHEN?",2,40]
  766.   USERBOX=0 : ROW=-1
  767.   Repeat 
  768.     B=0 : M=Mouse Key : AC=Asc(Inkey$) : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
  769.     Multi Wait 
  770.     If AC=30 and ROWOF>0 Then Dec ROWOF : Gosub ROWUPDAT
  771.     If AC=31 and ROWOF<ROWS-12 Then Inc ROWOF : Gosub ROWUPDAT
  772.     If M Then Gosub CHECKBUT
  773.     If ROW=-1 and B>29
  774.       ROW=B-30+ROWOF
  775.       TX["MIT WELCHER ZEILE VERTAUSCHEN?    ",2,40]
  776.       B=0
  777.     End If 
  778.   Until B>29 and ROW>-1
  779.   Add B,-30
  780.   If B<>ROW
  781.     SETUP["Vertausche Zeilen..."]
  782.     Swap RTX$(B),RTX$(ROW)
  783.     Swap RD(B),RD(ROW)
  784.     For A=0 To ENTRIES
  785.       If(A mod 10)=0 : SETMESS["Eintrag"+Str$(A)] : End If 
  786.       Swap DAT$(A,B),DAT$(A,ROW)
  787.     Next 
  788.     SHUTUP
  789.   End If 
  790.   B=0
  791.   Ink 2 : Bar 2,40 To 477,50
  792.   USERBOX=4+Min(ROWS,12)
  793.   Gosub REDRAW : Gosub ROWUPDAT
  794.   SETB[45,2,40,125,50,"EINF�GEN"]
  795.   SETB[46,127,40,250,50,"L�SCHEN"]
  796.   SETB[47,252,40,375,50,"AUSTAUSCHEN"]
  797.   SETB[48,377,40,477,50,"FERTIG!"]
  798. Return 
  799. REDRAW:
  800.   Ink 2 : Bar 2,52 To 477,197
  801.   For A=0 To Min(ROWS-1,11)
  802.     B[130,55+A*12,454,65+A*12]
  803.     SETB[A+49,1,55+A*12,129,65+A*12,""]
  804.   Next 
  805. Return 
  806. LOESCHEN:
  807.   P=0
  808.   If EDI Then ALERT["Bank noch nicht abgespeichert!","Weg damit!","Huch! Speichern","'Tschuldigung!"] : P=Param
  809.   If P=2 Then F$="" : Return 
  810.   If P=1
  811.     Gosub SPEICHERN
  812.     If F$=""
  813.       ALERT["Abbrechen, oder was?","Doch l�schen","Nee, vergi� es!",""]
  814.       If Param=1 : Return : End If 
  815.     End If 
  816.   End If 
  817.   For A=1 To ENTRIES
  818.     For B=0 To ROWS-1
  819.       DAT$(A,B)=""
  820.     Next 
  821.   Next 
  822.   EDI=0 : ENT=1 : ROW=0 : ROWOF=0 : B=0
  823.   Gosub ROWUPDAT
  824. Return 
  825. LADEN:
  826.   P=0
  827.   If EDI Then ALERT["Bank noch nicht abgespeichert!","Trotzdem laden","Huch! Speichern","'Tschuldigung!"] : P=Param
  828.   If P=2 Then F$="" : Return 
  829.   If P=1
  830.     Gosub SPEICHERN
  831.     If F$=""
  832.       ALERT["Abbrechen, oder was?","Doch laden","Nee, vergi� es!",""]
  833.       If Param=1 : Return : End If 
  834.     End If 
  835.   End If 
  836.   F$=Fsel$("*.dat","Bank.dat","Datenbank laden","")
  837.   If F$="" Then ALERT["Abgebrochen!","Schade!","",""] : Return 
  838.   If Exist(F$)=0 Then ALERT["Hey Du, die Datei existiert ja gar nicht!","Hoppla!","",""] : F$="" : Return 
  839.   SETUP["Lade Datei..."]
  840.   SETMESS["Lese File..."]
  841.   Open In 1,F$ : L=Lof(1) : ID$=Input$(1,4) : LE$=Input$(1,4) : Close 1
  842.   LE=Leek(Varptr(LE$))
  843.   If(ID$<>"DBAS") and(ID$<>"PACK") Then ALERT["Das ist keine AMOS-Datenbank!","'Tschuldigung!","",""] : F$="" : SHUTUP : Return 
  844.   Erase 16 : Reserve As Work 16,LE
  845.   ST=Start(16)
  846.   Bload F$,ST
  847.   If ID$="PACK"
  848.     SETMESS["Entpacke Datenbank..."]
  849.     B= Extension_5_00E4(ST+8,L-8)
  850.     If B+8<>LE
  851.       ALERT["Fehler beim Entpacken der Datei!("+Str$(B+8)+"<>"+Str$(LE)+")","Oh nein!","",""]
  852.       F$="" : SHUTUP : B=0 : Return 
  853.     End If 
  854.   End If 
  855.   If Deek(ST+12)>MXENT Then ALERT["Bank zu gro� (zu viele Eintr�ge!)","Mist!","",""] : F$="" : SHUTUP : Return 
  856.   If Deek(ST+14)>MXROW Then ALERT["Bank zu gro� (zu viele Zeilen!)","Mist!","",""] : F$="" : SHUTUP : Return 
  857.   If Leek(ST+16+Deek(ST+14)*18)<>$44415441 Then ALERT["Datei ist fehlerhaft!","Sch....","",""] : F$="" : SHUTUP : Return 
  858.   SETMESS["�bertrage Satzdaten..."]
  859.   ENTRIES=Deek(ST+12)
  860.   ROWS=Deek(ST+14)
  861.   For A=0 To ROWS-1
  862.     RD(A)=Deek(ST+16+A*18)
  863.     PULL[ST+18+A*18,16]
  864.     RTX$(A)=Param$
  865.   Next 
  866.   AD=ST+20+ROWS*18
  867.   PASS=0
  868.   If Leek(ST+8)=$50524F57
  869.     TEX$=""
  870.     INBOX["Datei kodiert. Passwort eingeben:","Fertig!","",60,2,0,0]
  871.     PASS=0
  872.     For A=1 To Len(TEX$)
  873.       Add PASS,Asc(Mid$(TEX$,A,1))*A
  874.     Next 
  875.     PASS=PASS mod $10000
  876.   End If 
  877.   If Leek(ST+8)=$50524F4E
  878.     TEX$=""
  879.     INBOX["Datei kodiert. Code eingeben:","Fertig!","",5,3,1,$FFFF]
  880.     PASS=Val(TEX$)
  881.   End If 
  882.   If PASS
  883.     SETMESS["Dekodiere Datenbank..."]
  884.     B=PASS : C=0
  885.     For A=AD To ST+LE-1 Step 2
  886.       Doke A,(Deek(A)-B) mod $10000
  887.       Add C,1,0 To 9 : If C=0 : Add B,1,1 To $FFFF : End If 
  888.     Next 
  889.   End If 
  890.   SETMESS["�bertrage Daten..."]
  891.   For A=1 To ENTRIES
  892.     For B=0 To ROWS-1
  893.       PULL[AD,RD(B)]
  894.       DAT$(A,B)=Param$
  895.       Add AD,RD(B)
  896.     Next 
  897.   Next 
  898.   SHUTUP
  899.   Erase 16
  900.   Gosub REDRAWROW
  901.   B[0,38,479,199]
  902.   For A=0 To Min(ROWS-1,11)
  903.     B[130,55+A*12,134+320,65+A*12]
  904.   Next 
  905.   EDI=0 : ENT=1 : ROWOF=0 : ROW=0 : B=0
  906.   Gosub ROWUPDAT
  907. Return 
  908. SPEICHERN:
  909.   P=0
  910.   If EDI=0 Then ALERT["Die Bank wurde doch gar nicht wesentlich ver�ndert!","Was geht Dich das an?","Hast recht!",""] : P=Param
  911.   If P=1 Then ALERT["Abgebrochen!","Schade!","",""] : Return 
  912.   F$=Fsel$("*.dat","Bank.dat","Datenbank speichern","")
  913.   If F$="" Then ALERT["Abgebrochen!","Schade!","",""] : Return 
  914.   P=0
  915.   If Exist(F$) Then ALERT["Datei existiert schon! Was nun?","�berschreiben!","Backup machen","Nichts speichern"] : P=Param
  916.   If P=2 Then ALERT["Abgebrochen!","Schade!","",""] : F$="" : Return 
  917.   SETUP["Speichere Datei..."]
  918.   If P=1
  919.     SETMESS["Erstelle Backup-Datei..."]
  920.     A$=F$-".dat"-".daT"-".dAt"-".dAT"-".Dat"-".DaT"-".DAt"-".DAT"
  921.     A$=A$+".bak"
  922.     If Exist(A$) : Kill A$ : End If 
  923.     Rename F$ To A$
  924.   End If 
  925.   LE=16+ROWS*18+4 : ED=0
  926.   For A=0 To ROWS-1
  927.     Add ED,ENTRIES*RD(A)
  928.   Next 
  929.   Add LE,ED
  930.   Erase 16 : Reserve As Work 16,LE
  931.   SETMESS["Berechne Header..."]
  932.   ST=Start(16)
  933.   Loke ST,$44424153 : Rem   "DBAS"=$44424153; "PACK"=$5041434B 
  934.   Loke ST+4,LE
  935.   Loke ST+8,$4E4F524D : Rem "NORM"=$4E4F524D; "PROT"=$50524F54 
  936.   Doke ST+12,ENTRIES
  937.   Doke ST+14,ROWS
  938.   For A=0 To ROWS-1
  939.     Doke ST+16+A*18,RD(A)
  940.     PUSH[RTX$(A),ST+18+A*18,16]
  941.   Next 
  942.   Loke ST+16+ROWS*18,$44415441 : Rem "DATA"=$44415441 
  943.   SETMESS["�bertrage Daten..."]
  944.   AD=ST+20+ROWS*18
  945.   For A=1 To ENTRIES
  946.     For B=0 To ROWS-1
  947.       GOT$=DAT$(A,B)
  948.       PUSH[DAT$(A,B),AD,RD(B)]
  949.       Add AD,RD(B)
  950.     Next 
  951.   Next 
  952.   If PASS
  953.     ALERT["Kodieren?","Sicher!","Nee!",""]
  954.     If Param=0
  955.       If PASSTYP=0 : Loke ST+8,$50524F57 Else Loke ST+8,$50524F4E : End If 
  956.       B=PASS : C=0
  957.       SETMESS["Kodiere..."]
  958.       For A=ST+20+ROWS*18 To AD-1 Step 2
  959.         Doke A,(Deek(A)+B) mod $10000
  960.         Add C,1,0 To 9 : If C=0 : Add B,1,1 To $FFFF : End If 
  961.       Next 
  962.     End If 
  963.   End If 
  964.   SETMESS[""]
  965.   ALERT["Soll ich die Bank noch packen?","Schlecht w�r's nicht!","Hmm... Nein, lieber nicht!",""]
  966.   P=Param
  967.   If P=1 Then SETMESS["Speichere..."] : Bsave F$,ST To ST+LE : EDI=0 : Erase 16 : B=0 : SHUTUP : Return 
  968.   Loke ST,$5041434B
  969.   ALERT["Welche Crunchrate?","Schnell","Mittel","Am besten"]
  970.   P=Param
  971.   If P=0 Then RATE=512
  972.   If P=1 Then RATE=1024
  973.   If P=2 Then RATE=4095
  974.   SETMESS["Packe..."]
  975.   B= Extension_5_00CE(ST+8,LE-8,1,RATE,2)
  976.   If B=0 Then ALERT["Crunching abgebrochen, nichts gespeichert!","Gut so!","",""] : F$="" : SHUTUP : Return 
  977.   If B<0 Then ALERT["Gepackte Datei wird l�nger als ungepackt!","Sowas aber auch!","",""] : F$="" : SHUTUP : B=0 : Return 
  978.   SETMESS["Speichere..."]
  979.   Bsave F$,ST To ST+B+8 : EDI=0 : Erase 16
  980.   SHUTUP
  981.   ALERT["Datei wurde auf"+Str$((B*100)/LE)+"% der urspr�nglichen L�nge verk�rzt!","Sehr gut!","Geht so!","Schlecht!"]
  982.   P=Param
  983.   If P=2 Then ALERT["Na h�r' mal, das sind immerhin"+Str$(LE-B)+" Bytes!","Entschuldige bitte!","Ach, vergi� es!",""]
  984.   B=0
  985. Return 
  986. ROWUPDAT:
  987.   For A=0 To Min(11,ROWS-1)
  988.     Ink 1,2 : Text 2,63+A*12,RTX$(A+ROWOF)+Space$(16-Len(RTX$(A+ROWOF)))
  989.   Next 
  990. UPDAENTRY:
  991.   If ENT>0
  992.     Ink 2 : Bar 2,40 To 477,50
  993.     TX["EINTRAG"+Str$(ENT)+" VON"+Str$(ENTRIES)+"    ",2,40]
  994.   End If 
  995.   Ink 1,2
  996.   For A=0 To Min(ROWS-1,11)
  997.     TEX$=DAT$(ENT,A+ROWOF)
  998.     Text 132,63+A*12,Left$(TEX$,Min(Len(TEX$),40))+Space$(Max(0,40-Len(TEX$)))
  999.   Next 
  1000. Return 
  1001. INIT1:
  1002.   Screen Open 0,640,200,4,$8000
  1003.   Flash Off : Paper 0 : Pen 1 : Curs Off : Cls 
  1004.   Palette 0,0,0,0
  1005.   Flash 21,"(F00,8)(C00,4)(800,4)(400,4)(000,8)(400,4)(800,4)(C00,4)"
  1006.   Limit Mouse 128,50 To 487,249
  1007.   EMP$="." : AUTORET=1 : PRLEN=80
  1008.   ENT=1 : MXENT=500 : MXROW=50 : ROWS=10 : ENTRIES=10 : ROWOF=0 : ROW=0
  1009. Return 
  1010. INIT2:
  1011.   BT[0,0,639,10,"DIE AMOS-DATENBANK V1.1 VON CHRISTOPHER HODGES!"]
  1012.   B[0,11,639,37]
  1013.   B[0,38,479,199]
  1014.   B[480,38,639,124]
  1015.   B[480,125,639,199]
  1016.   Restore DATS
  1017.   For A=1 To 22
  1018.     Read B(A,0),B(A,1),B(A,2),B(A,3),T$
  1019.     BT[B(A,0),B(A,1),B(A,2),B(A,3),T$]
  1020.   Next 
  1021.   For A=0 To MXROWS-1
  1022.     RTX$(A)=""
  1023.     RD(B)=40
  1024.   Next 
  1025.   For A=0 To 11
  1026.     B(A+30,0)=130 : B(A+30,1)=55+A*12
  1027.     B(A+30,2)=454 : B(A+30,3)=65+A*12
  1028.   Next 
  1029.   Ink 3 : A=1 : Gosub ARROWUP
  1030.   Ink 1 : A=0 : Gosub ARROWUP
  1031.   Ink 3 : A=1 : Gosub ARROWDOWN
  1032.   Ink 1 : A=0 : Gosub ARROWDOWN
  1033.   Fade 2,0,$FFF,$AAA,$444
  1034. Return 
  1035. ARROWUP:
  1036.   Bar 491+A,42+A To 492+A,78+A
  1037.   Draw 484+A,60+A To 491+A,42+A : Draw 484+A,61+A To 491+A,43+A
  1038.   Draw 500+A,60+A To 493+A,42+A : Draw 500+A,61+A To 493+A,43+A
  1039. Return 
  1040. ARROWDOWN:
  1041.   Bar 491+A,84+A To 492+A,120+A
  1042.   Draw 484+A,102+A To 491+A,120+A : Draw 484+A,101+A To 491+A,119+A
  1043.   Draw 500+A,102+A To 493+A,120+A : Draw 500+A,101+A To 493+A,119+A
  1044. Return 
  1045. CHECKBUT:
  1046.   B=0
  1047.   If USERBOX
  1048.     For A=45 To 44+USERBOX
  1049.       If X>B(A,0) and Y>B(A,1) and X<B(A,2) and Y<B(A,3) : B=A : Exit : End If 
  1050.     Next 
  1051.   End If 
  1052.   If B=0
  1053.     For A=1 To 22
  1054.       If X>B(A,0) and Y>B(A,1) and X<B(A,2) and Y<B(A,3) : B=A : Exit : End If 
  1055.     Next 
  1056.     If ROWS
  1057.       For A=30 To Min(29+ROWS,42)
  1058.         If X>B(A,0) and Y>B(A,1) and X<B(A,2) and Y<B(A,3) : B=A : Exit : End If 
  1059.       Next 
  1060.     End If 
  1061.   End If 
  1062.   If B=0 Then Return 
  1063.   P=0
  1064.   Repeat 
  1065.     M=Mouse Key : X=(X Mouse-128)*2 : Y=Y Mouse-50 : A=0
  1066.     If X>B(B,0) and Y>B(B,1) and X<B(B,2) and Y<B(B,3) Then A=1
  1067.     If A=1 and P=0 Then P=1 : PRESS[B]
  1068.     If A=0 and P=1 Then P=0 : REALISE[B]
  1069.   Until M=0
  1070.   If P=0 Then B=0 : Return 
  1071.   REALISE[B]
  1072. Return 
  1073. Procedure EINGABE[TX,TY,WX,MC,NUMS]
  1074.   Ink 1,2
  1075.   TEXX=0 : TEXOF=0 : ALT$="x" : RET=0
  1076.   Do 
  1077.     Multi Wait : I$=Inkey$ : AC=Asc(I$) : SC=Scancode : KS=Key Shift
  1078.     If AC=13 and AUTORET Then RET=1
  1079.     Exit If AC=13 or AC=27 or Mouse Key
  1080.     If SC=76 Then RET=-1+KS*1000 : Exit 
  1081.     If SC=77 Then RET=1-KS*1000 : Exit 
  1082.     If(NUMS and 1) and AC>31 and(AC<48 or AC>57) Then AC=0
  1083.     If AC>31 and Len(TEX$)<MC Then TEX$=Left$(TEX$,TEXX)+I$+Mid$(TEX$,TEXX+1) : Inc TEXX
  1084.     If SC=65 and KS=0 and TEXX>0 Then TEX$=Left$(TEX$,TEXX-1)+Mid$(TEX$,TEXX+1) : Dec TEXX
  1085.     If SC=70 and KS=0 and TEXX<Len(TEX$) Then TEX$=Left$(TEX$,TEXX)+Mid$(TEX$,TEXX+2)
  1086.     If SC=65 and KS and TEXX>0 Then TEX$=Mid$(TEX$,TEXX+1) : TEXX=0
  1087.     If SC=70 and KS and TEXX<Len(TEX$) Then TEX$=Left$(TEX$,TEXX) : TEXX=Len(TEX$)
  1088.     If AC=29 and TEXX>0 Then Dec TEXX
  1089.     If AC=28 and TEXX<Len(TEX$) Then Inc TEXX
  1090.     If SC=79 and KS Then TEXX=0
  1091.     If SC=78 and KS Then TEXX=Len(TEX$)
  1092.     If TEXX-TEXOF>WX-1 Then TEXOF=TEXX-WX+1
  1093.     If TEXX-TEXOF<0 Then TEXOF=Max(0,TEXX)
  1094.     Sprite 2,128+(TX+TEXX*8-TEXOF*8)/2,50+TY,1 : Wait Vbl 
  1095.     If(ALT$<>TEX$) or(ALTOF<>TEXOF)
  1096.       ALT$=TEX$ : ALTOF=TEXOF
  1097.       If NUMS and 2
  1098.         Text TX,TY+6,String$("*",Min(Len(TEX$)+TEXOF,WX))+String$(EMP$,Max(0,Min(WX,MC)-Len(TEX$)+TEXOF))
  1099.       Else 
  1100.         Text TX,TY+6,Mid$(TEX$,TEXOF+1,Min(Len(TEX$)+TEXOF,WX))+String$(EMP$,Max(0,Min(WX,MC)-Len(TEX$)+TEXOF))
  1101.       End If 
  1102.     End If 
  1103.   Loop 
  1104.   If NUMS and 1 Then TEX$=Str$(Val(TEX$))-" "
  1105.   If NUMS and 2
  1106.     Text TX,TY+6,String$("*",Min(Len(TEX$),WX))+Space$(Max(0,Min(WX,MC)-Len(TEX$)))
  1107.   Else 
  1108.     Text TX,TY+6,Left$(TEX$,Min(Len(TEX$),WX))+Space$(Max(0,Min(WX,MC)-Len(TEX$)))
  1109.   End If 
  1110.   Sprite Off 2 : Wait Vbl 
  1111. End Proc
  1112. Procedure BT[X1,Y1,X2,Y2,T$]
  1113.   Ink 2 : Bar X1,Y1 To X2,Y2
  1114.   Ink 1 : Draw X1,Y2-1 To X1,Y1
  1115.   Draw X1,Y1 To X2-1,Y1
  1116.   Ink 3 : Draw X1+1,Y2 To X2,Y2
  1117.   Draw X2,Y1+1 To X2,Y2
  1118.   X=X1+((X2-X1)-Len(T$)*8)/2
  1119.   Y=Y1+(Y2-Y1)/2+3
  1120.   Gr Writing 0
  1121.   Ink 3,2 : Text X+2,Y+1,T$
  1122.   Ink 1,2 : Text X+1,Y,T$
  1123.   Gr Writing 1
  1124. End Proc
  1125. Procedure SETB[A,X1,Y1,X2,Y2,T$]
  1126.   B(A,0)=X1 : B(A,1)=Y1 : B(A,2)=X2 : B(A,3)=Y2
  1127.   Ink 2 : Bar X1,Y1 To X2,Y2
  1128.   Ink 1 : Draw X1,Y2-1 To X1,Y1
  1129.   Draw X1,Y1 To X2-1,Y1
  1130.   Ink 3 : Draw X1+1,Y2 To X2,Y2
  1131.   Draw X2,Y1+1 To X2,Y2
  1132.   X=X1+((X2-X1)-Len(T$)*8)/2
  1133.   Y=Y1+(Y2-Y1)/2+3
  1134.   Gr Writing 0
  1135.   Ink 3,2 : Text X+2,Y+1,T$
  1136.   Ink 1,2 : Text X+1,Y,T$
  1137.   Gr Writing 1
  1138. End Proc
  1139. Procedure TX[T$,X,Y]
  1140.   If T$<>"" Then Ink 2 : Bar X,Y To X+Len(T$)*8,Y+8
  1141.   Gr Writing 0
  1142.   Ink 3,2 : Text X+1,Y+7,T$
  1143.   Ink 1,2 : Text X,Y+6,T$
  1144.   Gr Writing 1
  1145. End Proc
  1146. Procedure T[T$,Y]
  1147.   Gr Writing 0
  1148.   X=320-Len(T$)*4
  1149.   Ink 3+C,2 : Text X+1,Y+7,T$
  1150.   Ink 1+C,2 : Text X,Y+6,T$
  1151.   Gr Writing 1
  1152. End Proc
  1153. Procedure B[X1,Y1,X2,Y2]
  1154.   Ink 2 : Bar X1,Y1 To X2,Y2
  1155.   Ink 1 : Draw X1,Y2-1 To X1,Y1
  1156.   Draw X1,Y1 To X2-1,Y1
  1157.   Ink 3 : Draw X1+1,Y2 To X2,Y2
  1158.   Draw X2,Y1+1 To X2,Y2
  1159. End Proc
  1160. Procedure BE[X1,Y1,X2,Y2]
  1161.   Ink 1 : Draw X1,Y2-1 To X1,Y1
  1162.   Draw X1,Y1 To X2-1,Y1
  1163.   Ink 3 : Draw X1+1,Y2 To X2,Y2
  1164.   Draw X2,Y1+1 To X2,Y2
  1165. End Proc
  1166. Procedure PRESS[A]
  1167.   Ink 3 : Draw B(A,0),B(A,3)-1 To B(A,0),B(A,1)
  1168.   Draw B(A,0),B(A,1) To B(A,2)-1,B(A,1)
  1169.   Ink 1 : Draw B(A,0)+1,B(A,3) To B(A,2),B(A,3)
  1170.   Draw B(A,2),B(A,1)+1 To B(A,2),B(A,3)
  1171.   B(A,4)=1
  1172. End Proc
  1173. Procedure REALISE[A]
  1174.   Ink 1 : Draw B(A,0),B(A,3)-1 To B(A,0),B(A,1)
  1175.   Draw B(A,0),B(A,1) To B(A,2)-1,B(A,1)
  1176.   Ink 3 : Draw B(A,0)+1,B(A,3) To B(A,2),B(A,3)
  1177.   Draw B(A,2),B(A,1)+1 To B(A,2),B(A,3)
  1178.   B(A,4)=0
  1179. End Proc
  1180. Procedure PUSH[GOT$,STA,LE]
  1181.   AD=Varptr(GOT$)-1
  1182.   For A=1 To LE
  1183.     B=Peek(AD+A) : If A>Len(GOT$) Then B=0
  1184.     Poke STA+A-1,B
  1185.   Next 
  1186. End Proc
  1187. Procedure PULL[STA,LE]
  1188.   A$=""
  1189.   For A=0 To LE-1
  1190.     B=Peek(STA+A) : Exit If B=0
  1191.     A$=A$+Chr$(B)
  1192.   Next 
  1193. End Proc[A$]
  1194. Procedure ALERT[TITLE$,YES$,CANCEL$,NO$]
  1195.   Get Cblock 1,80,50,480,50
  1196.   BE[559,99,80,50]
  1197.   Ink 0 : Box 81,51 To 558,98
  1198.   B[82,52,557,97]
  1199.   T[TITLE$,56]
  1200.   BUT=3
  1201.   If NO$="" Then Dec BUT
  1202.   If CANCEL$="" Then Dec BUT
  1203.   Restore(BUT)
  1204.   T$=YES$
  1205.   For A=58 To BUT+57
  1206.     Read B(A,0),B(A,1),B(A,2),B(A,3)
  1207.     If A=59 Then T$=CANCEL$
  1208.     If A=60 Then T$=NO$
  1209.     BT[B(A,0),B(A,1),B(A,2),B(A,3),T$]
  1210.   Next 
  1211.   Repeat 
  1212.     B=0 : M=Mouse Key : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : AC=Asc(Inkey$)
  1213.     Multi Wait 
  1214.     If M Then Gosub CHECKBUT
  1215.   Until B
  1216.   Add B,-58
  1217.   Put Cblock 1
  1218. Goto SKIP
  1219. CHECKBUT:
  1220.   B=0 : P=0
  1221.   For A=58 To 57+BUT
  1222.     If X>B(A,0) and Y>B(A,1) and X<B(A,2) and Y<B(A,3) : B=A : Exit : End If 
  1223.   Next 
  1224.   If B=0 Then Return 
  1225.   Repeat 
  1226.     M=Mouse Key : X=(X Mouse-128)*2 : Y=Y Mouse-50 : A=0
  1227.     If X>B(B,0) and Y>B(B,1) and X<B(B,2) and Y<B(B,3) Then A=1
  1228.     If A=1 and P=0 Then P=1 : PRESS[B]
  1229.     If A=0 and P=1 Then P=0 : REALISE[B]
  1230.   Until M=0
  1231.   If P=0 Then B=0 : Return 
  1232.   REALISE[B]
  1233. Return 
  1234. 1 Data 100,70,540,90
  1235. 2 Data 100,70,315,90
  1236.   Data 325,70,540,90
  1237. 3 Data 100,70,240,90
  1238.   Data 246,70,386,90
  1239.   Data 392,70,540,90
  1240. SKIP:
  1241. End Proc[B]
  1242. Procedure SETUP[TITLE$]
  1243.   Get Cblock 2,80,50,480,50
  1244.   BE[559,99,80,50]
  1245.   Ink 0 : Box 81,51 To 558,98
  1246.   B[82,52,557,97]
  1247.   T[TITLE$,56]
  1248. End Proc
  1249. Procedure SETMESS[TITLE$]
  1250.   Ink 2 : Bar 83,66 To 556,96
  1251.   T[TITLE$,76]
  1252. End Proc
  1253. Procedure SHUTUP
  1254.   Put Cblock 2
  1255. End Proc
  1256. Procedure INBOX[TITLE$,YES$,NO$,LE,NUMS,MIZ,MAZ]
  1257.   Get Cblock 1,80,50,480,50
  1258.   BE[559,99,80,50]
  1259.   Ink 0 : Box 81,51 To 558,98
  1260.   B[82,52,557,97]
  1261.   T[TITLE$,54]
  1262.   BUT=2
  1263.   If NO$="" Then Dec BUT
  1264.   SETB[58,100,63,540,73,""]
  1265.   Restore(BUT+3)
  1266.   T$=YES$
  1267.   For A=59 To BUT+58
  1268.     Read B(A,0),B(A,1),B(A,2),B(A,3)
  1269.     If A=60 Then T$=NO$
  1270.     BT[B(A,0),B(A,1),B(A,2),B(A,3),T$]
  1271.   Next 
  1272.   Repeat 
  1273.     EINGABE[102,65,54,LE,NUMS]
  1274.     If NUMS and 1 Then TEX$=Str$(Max(Min(Val(TEX$),MAZ),MIZ))-" "
  1275.     B=0 : M=Mouse Key : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : AC=Asc(Inkey$)
  1276.     Multi Wait 
  1277.     If M Then Gosub CHECKBUT
  1278.   Until B>58 or RET=1
  1279.   If RET Then B=59
  1280.   Add B,-59
  1281.   Put Cblock 1
  1282. Goto SKIP
  1283. CHECKBUT:
  1284.   B=0 : P=0
  1285.   For A=59 To 58+BUT
  1286.     If X>B(A,0) and Y>B(A,1) and X<B(A,2) and Y<B(A,3) : B=A : Exit : End If 
  1287.   Next 
  1288.   If B=0 Then Return 
  1289.   Repeat 
  1290.     M=Mouse Key : X=(X Mouse-128)*2 : Y=Y Mouse-50 : A=0
  1291.     If X>B(B,0) and Y>B(B,1) and X<B(B,2) and Y<B(B,3) Then A=1
  1292.     If A=1 and P=0 Then P=1 : PRESS[B]
  1293.     If A=0 and P=1 Then P=0 : REALISE[B]
  1294.   Until M=0
  1295.   If P=0 Then B=0 : Return 
  1296.   REALISE[B]
  1297. Return 
  1298. 4 Data 100,75,540,95
  1299. 5 Data 100,75,315,95
  1300.   Data 325,75,540,95
  1301. SKIP:
  1302. End Proc[B]
  1303. '
  1304. DATS:
  1305. Data 2,13,142,23,"DATENBANK LADEN"
  1306. Data 144,13,284,23,"DATENBANK SICHERN"
  1307. Data 286,13,426,23,"DATENBANK L�SCHEN"
  1308. Data 428,13,637,23,"NEUE DATENBANK ANLEGEN"
  1309. Data 2,25,284,35,"DATENBANK VERSCHL�SSELN"
  1310. Data 286,25,426,35,"DATEI L�SCHEN"
  1311. Data 428,25,637,35,"AMOS-DATENBANK VERLASSEN!"
  1312. '
  1313. Data 482,40,502,80,""
  1314. Data 482,82,502,122,""
  1315. Data 504,40,637,50,"N�CHSTER EINTRAG"
  1316. Data 504,52,637,62,"VORHER. EINTRAG"
  1317. Data 504,64,637,74,"EINTRAG EINF�GEN"
  1318. Data 504,76,637,86,"EINTRAG L�SCHEN"
  1319. Data 504,88,637,98,"EINTRAG SUCHEN"
  1320. Data 504,100,637,110,"ALPHA. SORTIEREN"
  1321. Data 504,112,637,122,"SATZDATEN ï¿½NDERN"
  1322. '
  1323. Data 482,127,637,137,"EINTRAG DRUCKEN"
  1324. Data 482,139,637,149,"EINTRAG SICHERN"
  1325. Data 482,151,637,161,"SERIENBRIEF LADEN"
  1326. Data 482,163,637,173,"SERIENBRIEF SICHERN"
  1327. Data 482,175,637,185,"SERIENBRIEF ZEIGEN"
  1328. Data 482,187,637,197,"SERIENBRIEF DRUCKEN"